home *** CD-ROM | disk | FTP | other *** search
/ The Kara Collection / Kara Collection v3.0 (1996-09-12)(Cloanto).iso / utilities / h / 0 / 6 / 2 / rexx / antialiasfont.ctrx next >
Text File  |  1996-05-05  |  5KB  |  143 lines
  1. /* ColorType Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: AntiAliasFont.ctrx 1.0 */
  4.  
  5. /**
  6.  This script creates an anti-aliased font having the specified size.
  7.  Different shades of gray are used to give the illusion of a higher
  8.  resolution.
  9.  
  10.  For best results, it is recommended to either select an outline (vector)
  11.  font, such as Amiga fonts beginning with "CG" (Compugraphic fonts), or
  12.  to select a bitmapped font for which a larger size (exactly 2, 3 or 4
  13.  times the destination size, as indicated below) exists.
  14.  
  15.  The settings requester, which is displayed after the font requester,
  16.  includes the following parameters:
  17.  
  18.  Font: "Black on White" (white background, black characters), or "White on
  19.  Black" (black background, white characters).
  20.  
  21.  Anti-Alias: "Low" (4 colors - scale factor 2), "Medium" (8 colors - scale
  22.  factor 3) or "High" (16 colors - scale factor 4). The higher the value of
  23.  this setting, the more memory is required.
  24.  
  25.  For example, if the "High" option is selected for a font size of 8, this
  26.  program opens a monochrome font 4 times larger (i.e. size 32), and then
  27.  scales it down to size 8 using 16 shades of gray to create smoother outlines.
  28. */
  29.  
  30. IF ARG(1, EXISTS) THEN
  31.     PARSE ARG CTPORT
  32. ELSE
  33.     CTPORT = 'COLORTYPE'
  34.  
  35. IF ~SHOW('P', CTPORT) THEN DO
  36.     IF EXISTS('ColorType:ColorType') THEN DO
  37.         ADDRESS COMMAND 'Run >NIL: ColorType:ColorType'
  38.         DO 30 WHILE ~SHOW('P',CTPORT)
  39.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  40.         END
  41.     END
  42.     ELSE DO
  43.         SAY "ColorType could not be loaded."
  44.         EXIT 10
  45.     END
  46. END
  47.  
  48. IF ~SHOW('P', CTPORT) THEN DO
  49.     SAY 'ColorType Rexx port could not be opened.'
  50.     EXIT 10
  51. END
  52.  
  53. ADDRESS VALUE CTPORT
  54. OPTIONS RESULTS
  55. OPTIONS FAILAT 10000
  56.  
  57. LockGUI
  58. RequestFont '"Select the Font"'
  59. IF RC = 0 THEN DO
  60.     PARSE VALUE RESULT WITH '"' fontpath '" "' fontname '"' fontsize fontstyle .
  61.  
  62.     Request '"Settings" ' ||,
  63.            '"CYCLE = Font:, 2, 0, ""Black on White"", ""White on Black"" ' ||,
  64.            ' CYCLE = Anti-Alias:, 3, 0, Low, Medium, High "'
  65.     IF RC = 0 THEN DO
  66.         ptype = RESULT.1
  67.         scale = RESULT.2 + 2
  68.         colnum = 2 ** scale
  69.         bigsize = fontsize * scale
  70.  
  71.         FontExists '"'fontpath'" "'fontname'"' bigsize fontstyle
  72.         IF RC ~= 0 THEN DO
  73.             RequestResponse 'PROMPT "The specified font/size_cannot give the best results"'
  74.         END
  75.         IF RC = 0 THEN DO
  76.             NewFont
  77.             IF RC = 0 THEN DO
  78.                 errcode = 0
  79.                 LoadFont FORCE '"'fontpath'" "'fontname'"' bigsize fontstyle
  80.                 IF RC = 0 THEN DO
  81.                     tmpfname = 'T:ctrx_plt.'PRAGMA('ID')
  82.                     IF OPEN(pltfile, tmpfname, 'W') THEN DO
  83.                         IF ptype THEN DO   /* white on black */
  84.                             IF colnum = 4 THEN
  85.                                 WRITECH(pltfile, '464F524D 00000034 494C424D 424D4844 00000014 00000000 00000000 02020180 00000000 00000000 434D4150 0000000C 000000FF FFFFAAAA AA555555'X)
  86.                             ELSE IF colnum = 8 THEN
  87.                                 WRITECH(pltfile, '464F524D 00000040 494C424D 424D4844 00000014 00000000 00000000 03020180 00000000 00000000 434D4150 00000018 000000FF FFFFCACA CAAAAAAA 9292926D 6D6D4949 49242424'X)
  88.                             ELSE
  89.                                 WRITECH(pltfile, '464F524D 00000058 494C424D 424D4844 00000014 00000000 00000000 04020180 00000000 00000000 434D4150 00000030 000000FF FFFFEEEE EEDDDDDD CCCCCCBB BBBBAAAA AA999999 88888877 77776666 66555555 44444433 33332222 22111111'X)
  90.                         END
  91.                         ELSE DO             /* black on white */
  92.                             IF colnum = 4 THEN
  93.                                 WRITECH(pltfile, '464F524D 00000034 494C424D 424D4844 00000014 00000000 00000000 02020180 00000000 00000000 434D4150 0000000C FFFFFF00 00005555 55AAAAAA'X)
  94.                             ELSE IF colnum = 8 THEN
  95.                                 WRITECH(pltfile, '464F524D 00000040 494C424D 424D4844 00000014 00000000 00000000 03020180 00000000 00000000 434D4150 00000018 FFFFFF00 00002424 24494949 6D6D6D92 9292AAAA AACACACA'X)
  96.                             ELSE
  97.                                 WRITECH(pltfile, '464F524D 00000058 494C424D 424D4844 00000014 00000000 00000000 04020180 00000000 00000000 434D4150 00000030 FFFFFF00 00001111 11222222 33333344 44445555 55666666 77777788 88889999 99AAAAAA BBBBBBCC CCCCDDDD DDEEEEEE'X)
  98.                         END
  99.                         CALL CLOSE(pltfile)
  100.                     END
  101.                     Set 'FORCE "COLORS='colnum'" "PALETTE=""'tmpfname'"" "'
  102.                     IF RC = 0 THEN DO
  103.                         Get 'XMAX'
  104.                         xmax = RESULT % scale
  105.                         Get 'STRETCH'
  106.                         sflags = X2D(SUBSTR(RESULT, 3))
  107.                         nsflags = C2D(BITSET(D2C(sflags),2))    /* set "Color Average" bit */
  108.  
  109.                         Set 'FORCE STRETCH "XMAX='xmax'" "YMAX='fontsize'" "STRETCH='nsflags'"'
  110.                         IF RC ~= 0 THEN DO
  111.                             errcode = RC
  112.                             IF RC = 5 THEN
  113.                                 errmess = 'User abort during font resize.'
  114.                             ELSE
  115.                                 errmess = 'Error 'RC' during font resize.'
  116.                         END
  117.                         Set '"STRETCH='sflags'"'
  118.                     END
  119.                     ELSE DO
  120.                         errcode = RC
  121.                         errmess = 'Color environment_cannot be set:_error 'RC'.'
  122.                     END
  123.  
  124.                     ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  125.                 END
  126.                 ELSE DO
  127.                     errcode = RC
  128.                     IF RC = 5 THEN
  129.                         errmess = 'User abort during load.'
  130.                     ELSE
  131.                         errmess = 'Error 'RC' during load.'
  132.                 END
  133.  
  134.                 IF errcode > 0 THEN DO
  135.                     SAY errmess
  136.                     RequestNotify 'PROMPT="'errmess'"'
  137.                 END
  138.             END
  139.         END
  140.     END
  141. END
  142. UnlockGUI
  143.